00100	CFORS3     FORTRAN UNIT GENERATOR ROUTINE     
00200	C    *** MUSIC V ***     
00300	      SUBROUTINE FORSAM   
00400		DIMENSION ENVP(27),COSP(27)
00500	C COSP & ENVP STORE POINTERS FOR 'COS' & 'ENV' ARRAYS. SEE AT 105 FOR INFO.
00600		COMMON /LM/L(10),M(10),NSAMX
00700	C CAN USE UP TO 10 FIELDS IN UNIT GEN.
00800	      COMMON I(1) /P/P(1) /GENS/GENS(1) /LFUNC/LFUNC,XNFUN,PINCR
00900		1 /XIN/AMP,FREQ
01000		COMMON /INS/INS(1) /NT/RNT(1) /ROUT/ROUT(1)
01100	C  INS=INSTRUMENT DEFINITIONS, RNT=NOTE CARD INFO, ROUT=OUTPUT BLOCK
01200	      EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
01300	     1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(  
01400	     2 L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(AMP,XIN1),(FREQ,XIN2)
01500		3 ,(I5,I(5)),(I6,I(6)),(I3,I(3)),(L9,L(9))
01600	CC      XNFUN=LFUNC-1      
01700	C     COMMON INITIALIZATION OF GENERATORS     
01800	CX    N1=I6+2   
01900	C I6 HAS POINTER TO CODE (IN INS ARRAY) FOR U.G. NOW TO BE PROCESSED.
02000	CX	N2=INS(N1-1)-1
02100	CX    DO 204 J1=N1,N2      
02200	CX    J2=J1-N1+1  
02300	CX	IF(INS(J1).GE.0)GO TO 201
02400	CX200  L(J2)=-INS(J1)
02500	CX    M(J2)=1     
02600	CX    GO TO 204     
02700	CX201  M(J2)=0     
02800	CX 	IF(INS(J1)-26262.GT.0)GO TO 203
02850	C ********* ABOVE TAKEN OUT
02900	C***** WHAT DOES THE BIG NUMBER DO?????
03000	C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
03100	CX202  L(J2)=INS(J1)+I3-1 
03200	CX    GO TO 204     
03300	CX203  L(J2)=INS(J1)-26262  
03400	CX204  CONTINUE    
03500	CX    N3=INS(I6)  
03600	CX	IF(M1.LE.0)AMP=RNT(L1)      
03700	CX 	IF(M2.LE.0)FREQ=RNT(L2)     
03800	CX    J3=  N3 -100     
03900		CALL INITIT(J3)
04000	  	AMP=RNT(L1)      
04100	   	FREQ=RNT(L2)     
04200	      NSAM=I5   
04300	      NSAMX=NSAM-1
04400	C            OUT OSC AD2 RAI ENV STR AD3 AD4 MLT DIV RAH 
04500	      GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114,
04600		1 115,116,117,118),J3     
04700	CC	IF(NGEN.EQ.14)CALL OPT(L,M,NSAM)
04800	C  FOLLOWING IS SUGGESTED HEADER FOR SUBROUTINE OPT
04900	C	SUBROUTINE OPT(L,M,NSAM)
05000	C	DIMENSION L(8),M(8)     
05100	C	COMMON /GENS/GENS(1)/LFUNC/LFUNC/NT/RNT(1)/ROUT/ROUT(1)
05200	 112  CALL OPT(J1,J2,J3)
05400	114	RETURN
05450	113	CALL REVERB
05475	C ADD REVERB SUBROUTINE ONLY WHEN WANTED.  IT NEEDS EXTRA MEMORY.
05500	117	RETURN
05600	C 117 WILL BE FOR 'INP', READING EXTERNAL SOUND FILES.
05700	
05800	C     UNIT GENERATORS    
05900	C     OUTPUT BOX  
06000	CX 101  IF(M1.LE.0)IN1=RNT(L1) 
06100	CX    DO 270 J3=0,NSAM-1
06200	CX    IF(M1.GT.0)IN1=ROUT(J3+L1)
06300	CX 265  J5=L2+J3  
06400	CX    ROUT(J5)=IN1+ROUT(J5)    
06500	CX 270  CONTINUE    
06600	CX    RETURN      
06700	101	CALL OUTP
06800	C CALLS 'FAIL' OUT BOX
06900		RETURN
07000	CC101   DO 270 K=0,NSAMX 
07100	      J5=L2+K
07200	270   ROUT(J5)=ROUT(J5)+ROUT(K+L1)
07300	      RETURN
07400	C OUTPUT=WHAT'S THERE ALREADY + WHAT'S COMING IN FROM THIS INST.
07500	C  THIS NEW FORM ASSUMES THE OUT BOX HAS ONLY 'Bn' AS INPUT.
07600	
07700	C     OSCILLATOR    L1,L2 = P or B   L3=B   L4=F or P   L5=P
07800	C			AMPL, TIME, OUTPUT,  FUNC,    5TH NO LONGER USED.
07900	C M1, M2 =1 = NT.  =0 = ROUT  (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
08000	102	CALL OSC
08100	C  CALL 'FAIL' OSC.
08200		RETURN
08300	CXX 102  SUM=RNT(L5)      
08400		CALL LOCGEN(M4,L4)
08500	C  FINDS POINTER TO FUNC NUM.  IF M4.EQ.1 THEN FNUM WAS IN INST DEF. 
08600	CC	IF(M1.LE.0)AMP=RNT(L1)      
08700	CC   	IF(M2.LE.0)FREQ=RNT(L2)     
08800	      DO 293 J3=0,NSAMX  
08900	      J4=INT(SUM)+L4     
09000	      F=GENS(J4)     
09100	C GENS(J4) IS IN FUNC STORAGE AREA.
09200		IF(M2.GT.0)GO TO 286
09300	      SUM=SUM+FREQ
09400	      GO TO 290     
09500	 286  J4=L2+J3
09600	      SUM=SUM+ROUT(J4)  
09700	290     IF(SUM.GE.XNFUN)SUM=SUM-XNFUN
09800	CC290     IF(SUM.GE.XNFUN)GO TO 287
09900	CC     IF(SUM.LT.0.0)GO TO 289
10000	 288  J5=L3+J3
10100		IF(M1.GT.0)GO TO 292
10200	      ROUT(J5)=AMP*F     
10300	      GO TO 293     
10400	C**********
10500	CC287    SUM=SUM-XNFUN
10600	CC     GO TO 288
10700	CC289    SUM=SUM+XNFUN
10800	CC     GO TO 288
10900	C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
11000	 292  J6=L1+J3
11100	      ROUT(J5)=ROUT(J6)*F
11200	 293  CONTINUE    
11300	      RNT(L5)=SUM      
11400	C L5 POINTS TO NOTE ARRAY.     SAVE A POINTER.
11500	      RETURN      
11600	
11700	C 118 COS = CONTINUING, NEG. OSCILLATOR (FOR LEGATO)*** CAN'T PLAY CHORDS!!!
11800	118	L9=RNT(I3)
11900	C GET POINTER TO INS. NUM.
12000		SUM=COSP(L9)
12100	C ONLY 1 COS PER INSTRUMENT AT THIS TIME*****************
12200		GO TO 218
12300	C NOW JUMP AND ACT LIKE A 'NOS'.
12400	
12500	C 115 NEG OSCILLATOR  L1,L2 = P or B   L3=B   L4=F or P   L5=P
12600	C 'NOS'			 AMPL, TIME, OUTPUT,  FUNC,    5TH NO LONGER USED.
12700	C M1, M2 =1 = ROUT  =0 = PARM  (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
12800	115   SUM=RNT(L5)      
12900	218	CALL LOCGEN(M4,L4)
13000	C  FINDS POINTER TO FUNC NUM.  IF M4.EQ.1 THEN FNUM WAS IN INST DEF. 
13100	CC	IF(M1.LE.0)AMP=RNT(L1)      
13200	CC   	IF(M2.LE.0)FREQ=RNT(L2)     
13300	      DO 215 L7=0,NSAMX  
13400	      J4=INT(SUM)+L4     
13500	      F=GENS(J4)     
13600	C GENS(J4) IS IN FUNC STORAGE AREA.
13700		IF(M2.GT.0)GO TO 915
13800	      SUM=SUM+FREQ
13900	      GO TO 315
14000	915   J4=L2+L7
14100	      SUM=SUM+ROUT(J4)  
14200	315     IF(SUM.GE.XNFUN)GO TO 415
14300	       IF(SUM.LT.0.0)GO TO 615
14400	715   J5=L3+L7
14500		IF(M1.GT.0)GO TO 815
14600	      ROUT(J5)=AMP*F     
14700	      GO TO 215     
14800	C**********
14900	415    SUM=SUM-XNFUN
15000	       GO TO 715
15100	615    SUM=SUM+XNFUN
15200	       GO TO 715
15300	C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
15400	815   J6=L1+L7
15500	      ROUT(J5)=ROUT(J6)*F
15600	215   CONTINUE    
15700		IF(J3.EQ.18)GO TO 318
15800	C JUMP IF THIS IS 'COS' BEING PROCESSED
15900	      RNT(L5)=SUM      
16000	C L5 POINTS TO NOTE ARRAY.     SAVE A POINTER.
16100	      RETURN      
16200	318	COSP(L9)=SUM
16300	C SAVE POINTER FOR INST. L9
16400		RETURN
16500	
16600	C     ADD TWO BOX 
16700	C LOOK AT NT ARRAY FOR FIXED VALUES, LOOK AT ROUT FOR CHANGING VALS.
16800	CC103	IF(M1.LE.0)XIN1=RNT(L1)   
16900	CC      IF(M2.LE.0)XIN2=RNT(L2)   
17000	103      DO 258 J3=0,NSAMX    
17100		IF(M1.GT.0)XIN1=ROUT(J3+L1)
17200	    	IF(M2.GT.0)XIN2=ROUT(L2+J3)
17300	      ROUT(J3+L3)=XIN1+XIN2      
17400	 258  CONTINUE    
17500	      RETURN      
17600	
17700	C 116  SUBTRACT
17800	CC116	IF(M1.LE.0)XIN1=RNT(L1)   
17900	CC      IF(M2.LE.0)XIN2=RNT(L2)   
18000	116      DO 1016 J3=0,NSAMX    
18100		IF(M1.GT.0)XIN1=ROUT(J3+L1)
18200	    	IF(M2.GT.0)XIN2=ROUT(L2+J3)
18300	      ROUT(J3+L3)=XIN1-XIN2      
18400	 1016  CONTINUE    
18500	      RETURN      
18600	
18700	C RANDOM INTERPOLATING GENERATOR   RAI Px Py Bn Pq Pr Ps; OR RAI L1 L2 L3 L4 L5 L6;
18800	C M1=0=Pn   M1=1=Bn
18900	 104  SUM=RNT(L4)      
19000		  RN1=RNT(L5)  
19100	      RN3=RNT(L6)  
19200	CC	IF(M1.LE.0)XIN1=RNT(L1)     
19300	CC   	IF(M2.LE.0)XIN2=RNT(L2)     
19400		IF(SUM.NE.0)GO TO 313
19500		CALL RNDM(RN1)
19600		CALL RNDM(RN3)
19700	C INIT THE RANDOM NUMBERS.
19800	313      DO 340 J3=0,NSAMX    
19900		IF(M1.GT.0)XIN1=ROUT(J3+L1)     
20000	    	IF(M2.GT.0)XIN2=ROUT(J3+L2)     
20100	      IF(XNFUN.GT.SUM)GO TO 320
20200	CC    IF(SUM-XNFUN.LT.0)GO TO 320
20300	      SUM=SUM-XNFUN      
20400		CALL RNDM(RN4)
20500	304      RN2=RN4-RN3 
20600	      RN1=RN3     
20700	      RN3=RN4     
20800	      GO TO 321     
20900	 320  RN2=RN3-RN1 
21000	321   ROUT(J3+L3)=XIN1*(RN1+(RN2*SUM)/XNFUN)   
21100	      SUM=SUM+XIN2
21200	 340  CONTINUE    
21300	      RNT(L4)=SUM       
21400	      RNT(L5)=RN1  
21500	      RNT(L6)=RN3  
21600	      RETURN      
21700	
21800	C     ENVELOPE GENERATOR   ENV PorB, ForP, B,  P,   P,   P,  P,  P;
21900	C			       AMPL FUNC OUT ATCK STDY DCAY FLAG STOR
22000	C FLAG=1=NO CONTINUATION, REINITS FOR EACH NOTE AND CAN PLAY ON TOP OF SELF.
22100	C FLAG=0=INIT CONTINUATION FOR SEVERAL NOTES UNDER 1 ENV.
22200	C -1=CONTINUATION	(USE DIFFERENT INS. NUMS FOR CHORDS!!)
22300	105	L9=RNT(I3)
22400	C  GET INS. NUM.
22500		ENVX=RNT(L7)
22600		IF(ENVX)805,605,905
22700	905	SUM=RNT(L8)
22800		GO TO 705
22900	805	SUM=ENVP(L9)      
23000		GO TO 705
23100	605	SUM=0
23200		RNT(L7)=-1.
23300	705	CALL LOCGEN(M2,L2)
23400	C  FINDS POINTER TO FUNC NUM.  IF M2.EQ.1 THEN FNUM WAS IN INST DEF. 
23500	      XIN4=RNT(L4)
23600	      XIN5=RNT(L5)
23700	      XIN6=RNT(L6)
23800	      XIN5=PINCR/(PINCR/XIN5 - PINCR/XIN4 -PINCR/XIN6 )
23900	C XIN5 HAS INCR. VALUE OF STEADY STATE. (IT WAS TOTAL DUR. BEFORE.)
24000	C THESE 3 PARAMS ARE ATTACK DUR, TOTAL DUR, DECAY DUR.
24100	C  STEADY STATE TIME IS COMPUTED
24200	CC	IF(M1.LE.0)AMP =RNT(L1)     
24300	CX 	IF(M4.LE.0)XIN4=FLOAT(RNT(L4))*SFI     
24400	CX 	IF(M5.LE.0)XIN5=FLOAT(RNT(L5))*SFI     
24500	CX 	IF(M6.LE.0)XIN6=FLOAT(RNT(L6))*SFI     
24600	      XIN4=XIN4/4.
24700	      XIN5=XIN5/4.
24800	      XIN6=XIN6/4.
24900	CC 387  X1=XNFUN/4. 
25000	CC    X2=X1+X1    
25100	CC    X3=X2+X1    
25200		X1=128.
25300		X2=256.
25400		X3=384.
25500	C THESE NUMBERS BASED ON USING 3/4 OF 512 ARRAY.
25600	      DO 205 J3=0,NSAMX    
25700	      J4=INT(SUM)+L2     
25800	      F=GENS(J4)     
25900		IF(M1.GT.0)AMP =ROUT(J3+L1)      
26000	   	IF(SUM.GE.384.)SUM=0
26100	C FOR WRAP-AROUND
26200	   	IF(SUM.GE.128.)GO TO 305
26300	C JUMP IF ATTACK BOUNDRY IS PASSED.
26400	CC 	IF(SUM-X3.GE.0)SUM=SUM-X3
26500	CC 	IF(SUM-X1.GT.0)GO TO 305
26600	CX  	IF(M4.GT.0)XIN4=FLOAT(ROUT(J3+L4))      
26700	      SUM=SUM+XIN4       
26800	      GO TO 405    
26900	305	IF(SUM.GE.256.)GO TO 505
27000	C JUMP IF STEADY STATE BOUNDRY IS PASSED.
27100	CC305	IF(SUM-X2.GT.0)GO TO 505
27200	CX  	IF(M5.GT.0)XIN5=FLOAT(ROUT(J3+L5))      
27300	      SUM=SUM+XIN5       
27400	      GO TO 405    
27500	CX505	IF(M6.GT.0)XIN6=FLOAT(ROUT(J3+L6))      
27600	505   SUM=SUM+XIN6       
27700	 405  J7=L3+J3
27800	      ROUT(J7)=AMP*F     
27900	 205  CONTINUE   
28000		IF(ENVX.LE.0)GO TO 1005
28100		RNT(L8)=SUM
28200		RETURN
28300	1005  ENVP(L9)=SUM       
28400	      RETURN     
28500	
28600	C     STEREO OUTPUT BOX  L1,L2 = B       L3=B1
28700	C IT IS ASSUMED ALL INPUTS ARE 'B' TYPE.
28800	106   NSSAM=2*NSAM       
28900	C  6/29/70  L.C.SMITH
29000	      ICT=0
29100	      DO 206 J3=1,NSSAM,2  
29200	      J4=L1+ICT
29300	      XIN1=ROUT(J4)  
29400	 306  J5=L3+J3-1 
29500	      ROUT(J5)=XIN1+ROUT(J5)    
29600	506   J4=L2+ICT
29700	      XIN2=ROUT(J4)  
29800	 406  J5=L3+J3   
29900	      ROUT(J5)=XIN2+ROUT(J5)    
30000	 206  ICT=ICT+1  
30100	      RETURN     
30200	C     STEREO OUTPUT BOX  
30300	CX106	IF(M1.GT.0)GO TO 501
30400	CCC 106  IF(M1)500,500,501  
30500	CX 500  IN1=I(L1)  
30600	CX501	IF(M2.GT.0)GO TO 503
30700	CCC 501  IF(M2)502,502,503  
30800	CX 502  IN2=I(L2)  
30900	CX 503  NSSAM=2*NSAM       
31000	C  6/29/70  L.C.SMITH
31100	CX      ICT=0
31200	CX      DO 206 J3=1,NSSAM,2  
31300	CX	IF(M1.LE.0)GO TO 306
31400	CCC   IF(M1)306,306,504  
31500	CC*** 504  J4=L1+J3-1 
31600	CX504   J4=L1+ICT
31700	CX      IN1=I(J4)  
31800	CX 306  J5=L3+J3-1 
31900	CX      I(J5)=IN1+I(J5)    
32000	CX	IF(M2.LE.0)GO TO 406
32100	CCC   IF(M2)406,406,506  
32200	CC*** 506  J4=L2+J3-1 
32300	CX506   J4=L2+ICT
32400	CX      IN2=I(J4)  
32500	CX 406  J5=L3+J3   
32600	CX      I(J5)=IN2+I(J5)    
32700	CX 206  ICT=ICT+1  
32800	CX      RETURN     
32900	
33000	C     ADD 3 BOX  
33100	CC107	IF(M1.LE.0)XIN1=RNT(L1)  
33200	CC   	IF(M2.LE.0)XIN2=RNT(L2)  
33300	107   	IF(M3.LE.0)XIN3=RNT(L3)  
33400	      DO 780 J3=0,NSAMX    
33500		IF(M1.GT.0)XIN1=ROUT(L1+J3)
33600	   	IF(M2.GT.0)XIN2=ROUT(L2+J3)
33700	   	IF(M3.GT.0)XIN3=ROUT(L3+J3)
33800	      ROUT(J3+L4)=XIN1+XIN2+XIN3  
33900	 780  CONTINUE   
34000	      RETURN     
34100	
34200	C     ADD 4 BOX  
34300	CC 108  IF(M1.LE.0)XIN1=RNT(L1)  
34400	CC      IF(M2.LE.0)XIN2=RNT(L2)  
34500	108      IF(M3.LE.0)XIN3=RNT(L3)  
34600	      IF(M4.LE.0)XIN4=RNT(L4)  
34700	      DO 880 K=0,NSAMX    
34800	      IF(M1.GT.0)XIN1=ROUT(L1+K)  
34900	 859  IF(M2.GT.0)XIN2=ROUT(L2+K)
35000	      IF(M3.GT.0)XIN3=ROUT(L3+K)
35100	 863  IF(M4.GT.0)XIN4=ROUT(L4+K)
35200	      ROUT(L5+K)=XIN1+XIN2+XIN3+XIN4      
35300	880   CONTINUE   
35400	      RETURN     
35500	
35600	C     MULTIPLIER 
35700	CC109   IF(M1.LE.0)XIN1=RNT(L1)
35800	CC      IF(M2.LE.0)XIN2=RNT(L2)
35900	109      DO 908 J3=0,NSAMX
36000	      IF(M1.GT.0)XIN1=ROUT(J3+L1)
36100	      IF(M2.GT.0)XIN2=ROUT(J3+L2)
36200	      ROUT(J3+L3)=XIN1*XIN2
36300	 908  CONTINUE   
36400	      RETURN     
36500	
36600	C 110 DIVIDER
36700	CC110   IF(M1.LE.0)XIN1=RNT(L1)
36800	CC      IF(M2.LE.0)XIN2=RNT(L2)
36900	110      DO 1010 J3=0,NSAMX
37000	      IF(M1.GT.0)XIN1=ROUT(J3+L1)
37100	      IF(M2.GT.0)XIN2=ROUT(J3+L2)
37200	1010      ROUT(J3+L3)=XIN1/XIN2
37300	      RETURN     
37400	
37500	
37600	C     SET NEW FUNCTION IN OSC OR ENV     
37700	CC 110  ILOC=N1+6  
37800	CC      IF(INS(N1+1).EQ.105) ILOC=N1+4 
37900	CC      JN1=I(3)+INS(N1)-1   
38000	CC      IIN1=RNT(JN1)
38100	CC     IF(IIN1.GT.0) INS(ILOC)=-(IIN1-1)*LFUNC-1    
38200	C 'SET' NO LONGER NEEDED!!!!  NOW 110 CAN BE USED FOR SOMETHING ELSE.
38300	
38400	C     RANDOM AND HOLD GENERATOR     RAH Px Py Bn Pq Pr; OR RAH L1 L2 L3 L4 L5;
38500	C M1=0=Pn   M1=1=Bn
38600	 111  SUM=RNT(L4)       
38700	CC      IF(M1.LE.0)XIN1=RNT(L1)      
38800	CC      IF(M2.LE.0)XIN2=RNT(L2)      
38900	 913  RN=RNT(L5)  
39000		IF(SUM.EQ.0)CALL RNDM(RN)
39100	C TO INIT RANDOM NUMB.  (COULD THIS EVER LOSE?)
39200	      DO 940 J3=0,NSAMX    
39300	      IF(M1.GT.0) XIN1=ROUT(J3+L1)      
39400	      IF(M2.GT.0) XIN2=ROUT(J3+L2)      
39500	      IF(XNFUN.GT.SUM)GO TO 920
39600	CC    IF(SUM-XNFUN.LT.0)GO TO 920
39700	      SUM=SUM-XNFUN      
39800		CALL RNDM(RN)
39900	920   ROUT(J3+L3)=XIN1*RN 
40000	      SUM=SUM+XIN2       
40100	 940  CONTINUE   
40200	      RNT(L4)=SUM       
40300	      RNT(L5)=RN  
40400	      RETURN     
40500	
60000	      END
60100	
60200		SUBROUTINE RNDM(X)
60300		X=2.*RAN(X)-1.
60400	C SENDS BACK NUMBER BETWEEN -1 AND +1
60500		END
60600	
60700		SUBROUTINE LOCGEN(M,L)
60800		COMMON /NT/RNT(1) /LOCG/LOCG(1)
60900		IF(M.EQ.0)L=LOCG(INT(RNT(L)))
61000	C GET POINTER TO START OF FUNC. ARRAY
61100		END
61200	
61300	 	SUBROUTINE OPT(L,M,NSAM)
61400	 	DIMENSION L(1),M(1)     
61500	 	COMMON /GENS/GENS(1)/LFUNC/LFUNC,XNFUN
61600		1/NT/RNT(1)/ROUT/ROUT(1)
61700	C THIS IS A DUMMY ROUTINE     OPT Pm Pn Bn;  doubles value of Bn
61800		J1=L(3)
61900	C L(3) MEANS LOOK AT 3RD FIELD OF 'OPT'
62000		J2=J1+NSAM-1
62100		DO 1 K=J1,J2   
62200	1	ROUT(K)=ROUT(K)*2
62300		RETURN
62400		END